Shareware Grab Bag/Shareware Grab Bag.iso/050/madtrb17.arc/TREK_PLY.P

Text File | 1985-09-08 | 32KB | 1,195 lines

(*
::::::::::
TRK.PLAY.TEXT
::::::::::
*)
(* overlay *) procedure playgame(var gstat: integer);
label 10;

  function findit(fromx,fromy,tox,toy:integer):real;
  var
     enemy:real;
  begin
     if babble then findit:= rand(0,119) /10
     else
    if tox=fromx then
       if toy-fromy>0 then findit:= 0
       else findit:= 6
    else begin
       enemy:= arctan((toy-fromy)/(tox-fromx))/pi*180;
       if enemy-90<0 then enemy:= enemy+360;
       enemy:= (enemy-90)/30;
       if abs(tox-fromx) div (tox-fromx)=-1 then findit:= 18 - enemy
       else findit:= 12 - enemy
      end
  end;

  function hit(distance:real; var xco,yco: integer;
                   fromx, fromy:integer):boolean;
  begin
    hit:=false;
    xco:=fromx+round(distance*cos((90-30*direction)*pi/180));
    yco:=fromy+round(distance*sin((90-30*direction)*pi/180));
    if ok(xco,yco) then
      if (universe[xco,yco].ch <> ' ') and not((xco=fromx) and (yco=fromy)) then
    hit:=true
  end;

  function out(which : system):boolean;
  begin
    out:= systems[which] < opefficiency
  end;

  procedure writenum(towrite,leng,x,y:integer);
  var
     i: integer;
    s : packed array[0..9] of char;
  begin
      for i:= 1 to leng do begin
      if towrite = 0 then
          if i = 1 then
          s[leng - i] := '0'
          else
          s[leng - i] := ' '
      else
          s[leng - i] := chr(48 + towrite mod 10);
      towrite:= towrite div 10
      end;
      gotoxy(x+1,y+1);
      for i := 0 to leng - 1 do write(s[i]);
  end;

  procedure writestr(x,y : integer; str : string80);
  begin
    gotoxy(x+1,y+1); write(str)
  end;

  procedure updateboard;
  var
     j:  system;
     i,x,y: integer;
     red: boolean;
  begin
     if condition <>'docked' then
    begin
    condition:= 'green ';
    for j:= computer to impulse do
     if systems[j] < 75 then condition:= 'yellow';
    condcheck(currx,curry,red);
    if red then condition:= 'red   '
    end;
     if not out(computer) and not out(shortscan) then short(currx,curry);
     numstr(currx,3,0); writestr(54,12,str);
     numstr(curry,3,0); writestr(59,12,str);
     writenum(shields,5,71,6);
     writenum(totalpower-shields,5,71,7);
     writenum(nmbrkling,2,74,8);
     writenum(nmbrbases,2,74,9);
     writenum(nmbrtorps,2,74,10);
     writenum(level,3,47,12);
     writenum(points,5,57,13);
     numstr(stardate,6,1); writestr(70,12,str);
     numstr(deadline,6,1); writestr(70,13,str);
     writestr(70,14,condition)
  end;

  procedure finishup(knownstate: boolean);
  begin
    updateboard;
    addscroll('------------ End ------------');
    if not knownstate then
      if shields < 0 then
    begin
      clearscroll;
      addscroll('You have been destroyed. Some');
      addscroll('commander you are!  Your crew');
      addscroll('probably would have mutinied');
      addscroll('anyway.');
      gstat := 0
    end
      else if stardate >= deadline then
    begin
      clearscroll;
      addscroll('You have run out of time.  The');
      addscroll('Organians have intervened in your');
      addscroll('behalf when they saw what a blundering');
      addscroll('excuse for a commander you were.');
      gstat := 2
    end
      else gstat := 4;
    delay(500);
    scroll;
    addscroll('Lt. Uhura reports:');
    scroll;
    addscroll('Message from starfleet runs as follows:');
    scroll;
    if not baseattacked then begin
    addscroll('Your new position n Starfleet,');
    addscroll(' effective immediately:  ');
    scroll;
    if points>8000 then addscroll('      SUPREME COMMANDER')
    else if points>6000 then addscroll('     ADMIRAL')
    else if points>5000 then addscroll('     COMMODORE')
    else if points>4000 then addscroll('    COMMANDER')
    else if points>3000 then addscroll('   LIEUTENANT COMMANDER')
    else if points>2000 then addscroll('   STEWARD')
    else if points>1000 then addscroll('   ENSIGN')
    else addscroll('     SPACE GARBAGE');
    end
    else begin
    addscroll('We told you so...');
    addscroll('   crime does not pay!');
    end;
    delay(6000);
    alldone := true;
  end;

  procedure doquestion(questx,questy : integer; encounter : attack); forward;
   { enemy attack and getcommand are mutually recursive with this }

  procedure enemyattack(whattodo: what);
  const
     maxobj = 20;
  type
     obj_range =  0..maxobj;
  var
     tempkling,tempbase:  obj_range;
     klingloc,baseloc:  array [obj_range,1..2] of integer;
     shot,klingx,klingy,basex,basey:  integer;
     unknown: boolean;

     procedure shieldchek;
     var
    i: integer;
    swarn, rwarn: packed array[0..9] of char;
     begin
    swarn := 'SHIELDS LO';
    rwarn := 'RESERVE LO';
    if totalpower - shields < 0 then shields:= totalpower;
    if shields < 0 then
        finishup(false)
    else
         for i:= 1 to 10 do
           begin
         gotoxy(43,22);
         if shields < 200 then write(swarn)
         else write('          ');
         gotoxy(43,23);
         if totalpower - shields < 200 then write(rwarn)
         else write('          ');
           end;
     end;

     procedure klingmove(fromx,fromy:  integer);
     var
    distance,x,y:  integer;
     begin
    direction:= findit(fromx,fromy,currx,curry);
    if (universe[fromx,fromy].strength < 100) or (nmbrkling < 5) then
       if direction >6 then direction:= direction - 6
       else direction:= direction + 6;
    if sqrt(sqr(fromx-currx)+sqr(fromy-curry))< level + 3 then
       distance:= trunc(sqrt(sqr(fromx-currx)+sqr(fromy-curry)))
    else distance:= level + 3;
    if hit(rand(2,distance),x,y,fromx,fromy) then moveround(x,y);
    if ok(x,y) then
       begin
       universe[x,y]:= universe[fromx,fromy];
       if not ((x=fromx) and (y=fromy)) then
          with universe[fromx,fromy] do
         begin
         strength:= 0;
         ch:= ' '
         end
       end
     end;

     procedure shoot(fromx,fromy:  integer);
     label 10;
     begin
    with universe[fromx,fromy] do begin
       if whattodo = pass then shot:= rand(0,2500)
       else shot:= round(1/(sqr(currx-fromx)+sqr(curry-fromy))*
        rand(0,strength));
       if allshields < 0 then
          begin
          shields:=shields-shot;
          totalpower:= totalpower-shot
          end;
       if shot> 0 then
          begin
          scroll;
          numstr(shot,4,0);
          addln(str);
          addln(' unit hit by');
          if whattodo = pass then
         begin
         addscroll(' unknown means');
         shieldchek;
         partdone := true;
         goto 10;
         end
          else case ch of
         '+': addscroll(' Klingon');
         'X': addscroll(' Klingon base');
         'H': addscroll(' Hydran');
         'T': addscroll(' Tholian');
         'R': addscroll(' Romulan');
         'A': addscroll(' Argelian');
         '#','B': addscroll(' starbase')
         end;
          scroll
          end
       end;
  10: end;



     procedure anyshoot(fromx,fromy,tox,toy: integer);
     begin
    shot:= rand(0,500+level*100) div (sqr(fromx-tox) + sqr(fromy-toy));
    if universe[tox,toy].strength < shot then
       with universe[tox,toy] do
          begin
          case ch of
         'A':  addscroll('***Argelian shape-changer destroyed***');
         'T':  addscroll('***Tholian destroyed***');
         'R':  addscroll('***Romulan destroyed***');
         '+':  begin
               nmbrkling:= nmbrkling - 1;
               addscroll('***Klingon destroyed***')
               end;
         'X':  addscroll('***Klingon base destroyed***');
         '#':  begin
               addscroll('***Starbase destroyed***');
               nmbrbases:= nmbrbases - 1;
               if condition = 'docked' then
              begin
              condition:= 'red   ';
              shields:= maxpower;
              totalpower:= maxpower;
              clrmesg;
              mesg(2,'  Lt. Sulu reports:');
              mesg(4,' ENTERPRISE undocked');
              mesg(5,'    and in battle');
              delay(2000)
              end
               end ;
         end;
          ch:= ' ';
          strength:= 0;
          printch(50+tox-currx,5-toy+curry,' ');
          end
    else universe[tox,toy].strength:= universe[tox,toy].strength - shot;
     end;

     procedure scan_it;
     var
    i,x,y:  integer;
     begin
    partdone := false;
    tempkling:=0;
    tempbase:=0;
    for x:= currx - 10 to currx + 10 do
       for y:= curry - 5 to curry + 5 do
         if ok(x,y) then
         case universe[x,y].ch of
            'H','O','R','A','T','X','+':  begin
              tempkling:= tempkling + 1;
              klingloc[tempkling,1]:= x;
              klingloc[tempkling,2]:= y;
              if universe[x,y].ch = 'O' then if (currlst >= 'a')
                 and (rand(0,2) = 1) then
                 begin
                for i:= rand(0,ord(currlst) - ord('a')) to
                   ord(currlst) - ord('a') - 1 do
                  list[chr(i + ord('a'))]:= list[chr(i +
                   ord('b'))];
                currlst:= pred(currlst)
                 end
              end;
            'B','#':  begin
              tempbase:= tempbase + 1;
             baseloc[tempbase,1]:= x;
              baseloc[tempbase,2]:= y
              end;
            '.':  if allshields < 0 then
                 begin
                 totalpower:= totalpower - trunc(300 * 1 /
                 (sqr(x-currx)+sqr(y-curry)));
                 shields:= shields - trunc(300 * 1 / (sqr(x-currx)+
                sqr(y-curry)))
                 end;
            '?':  begin doquestion(x,y,chanced); partdone := true end
           end
     end;

     procedure fire_it;
     label 10;
     var
    i,j:  obj_range;
     begin
    partdone := false;
    if whattodo = pass then shoot(currx - 1, curry);
    for i:= 1 to tempkling do
       begin
       klingx:= klingloc[i,1];
       klingy:= klingloc[i,2];
       for j:= 1 to tempbase do
          begin
          basex:= baseloc[j,1];
          basey:= baseloc[j,2];
          if universe[klingx,klingy].ch in ['X','+','R','A','T','H'] then
         anyshoot(klingx,klingy,basex,basey);
          if (universe[klingx,klingy].ch in ['X','+','R','A','T']) and
         (universe[basex,basey].ch in ['#','B']) then
         anyshoot(basex,basey,klingx,klingy);
          end
       end;
    for i:= 1 to tempkling do
       if universe[klingloc[i,1],klingloc[i,2]].ch <> ' ' then
          begin
          if (condition <> 'docked') and (universe[klingloc[i,1],klingloc
         [i,2]].ch <> 'O') then
         begin
         shoot(klingloc[i,1],klingloc[i,2]);
         if partdone then goto 10;
         disable(shot)
         end;
         with universe[klingloc[i,1],klingloc[i,2]] do
          if not (ch in ['X','A','T','H','O']) and not((ch = '+') and
          (nomove > -1)) then
        klingmove(klingloc[i,1],klingloc[i,2])
          end;
    if baseattacked then for i:= 1 to tempbase do
       begin
       shoot(baseloc[i,1],baseloc[i,2]);
       if partdone then goto 10;
       disable(shot)
       end;
    shieldchek;
10:  end;

  begin
    if whattodo = go then
      scan_it;
    if not partdone then
      fire_it;
  end; { enemyattack}

  procedure battleinfo;
  var
     x,y: integer;
     onefound:  boolean;
 begin
     onefound:= false;
     for y:=curry+5 downto curry -5 do
    for x:=currx-10 to currx+10 do
       begin
       if ok(x,y) then
          if universe[x,y].ch in ['R','H','T','+','X'] then
         begin
         onefound:= true;
         case universe[x,y].ch of
            '+':  addln('Klingon warship ');
            'X':  addln('Klingon base ');
            'R':  addln('Romulan ');
            'H':  addln('Hydran ');
            'T':  addln('Tholian ')
            end;
        numstr(findit(currx,curry,x,y),4,1);
         addln(concat('at ',str));
         numstr(sqrt(sqr(x-currx)+sqr(y-curry)),4,1);
         addscroll(concat(' and ',str,' parsecs'));
         numstr(round(universe[x,y].strength / 100) * 100,4,0);
         if universe[x,y].ch <>'H' then
            addscroll(concat('     Enemy shields estimated at ',str))
         end;
       if (y=curry-5) and (x=currx+10) and not onefound then
          begin
          clrmesg;
          mesg(3,'      No klingons');
          mesg(4,' reported in area, sir')
          end
       end;
    scroll
  end;

  procedure scanlong;
  var
    temp, temp2, i, j: integer;
  begin
    if not out(longscan) then
       begin
       sector(currx-21,curry+11,j);    writenum(j,4,64,0);
       sector(currx,curry+11,j);    writenum(j,4,69,0);
       sector(currx+21,curry+11,j);    writenum(j,4,74,0);
       sector(currx-21,curry,j);    writenum(j,4,64,2);
       sector(currx,curry,j);        writenum(j,4,69,2);
       sector(currx+21,curry,j);    writenum(j,4,74,2);
       sector(currx-21,curry-11,j);    writenum(j,4,64,4);
       sector(currx,curry-11,j);    writenum(j,4,69,4);
       sector(currx+21,curry-11,j);    writenum(j,4,74,4)
       end
    else begin
       clrmesg;
       mesg(3,'  Longrange scanners');
       mesg(4,'   are out yet, sir')
       end
  end;

  procedure moveship(x,y:integer);
  begin
    if ok(currx,curry) then
       begin
       universe[currx,curry].ch:= ' ';
       universe[currx,curry].strength:= 0
       end;
    if ok(x,y) then universe[x,y].ch:='@';
    currx:= x;
    curry:= y
  end;

  procedure writestuff(casenum: integer);
  begin
     addscroll('Mr. Spock reports:');
     scroll;
     case casenum of
    1:  begin
        addscroll('     Captain, we appear to have moved');
        addscroll('some distance in an unknown direction.')
        end;
    2:  begin
        addscroll('     Captain, apparently we have been');
        addscroll('thrust into a time warp. We have lost');
        addscroll('valuable time.')
        end;
    3:  begin
        addscroll('     Captain, we have inexplicably lost');
        addscroll('much power. Life support is working ');
        addscroll('yet, however.')
        end;
    4:  begin
        addscroll('     Captain, our entire weapons');
        addscroll('systems is dead.')
        end;
    5:  begin
        addscroll('     Captain, all systems are ');
        addscroll('diminished in capacity to function.');
        addscroll('In other words, something has attacked');
        addscroll('only our systems.')
        end;
    6:  begin
        addscroll('     Captain, we have been hit by an');
        addscroll('incredibly powerful blast.');
        if shields >= 0 then addscroll('We are lucky to have survived.')
        end;
    8:  begin
        addscroll('     Captain, we have apparently gained');
        addscroll('an extraordinary amount of power.')
        end;
    9:  begin
        addscroll('     Captain, we apparently have been');
        addscroll('thrust into a time warp. We have gained');
        addscroll('time.')
        end;
       10:  begin
        addscroll('     Captain, all systems have suddenly');
        addscroll('gone to 100% for no apparent reason.')
        end
     end
  end;

  procedure raiseshields;
  begin
     repeat
    clrmesg;
    mesg(3,'   How much power');
    mesg(4,'   to the shields?');
    shields := readint
     until (totalpower>=shields);
     clrmesg
  end;

  procedure move;
  var
     speed:  real;
     adjspeed,x,y,i:  integer;

     procedure findobject(x,y: integer; var str: string80);
     begin
    case universe[x,y].ch of
       '+': str:= 'Klingon';
       'X': str:= 'Klingon base';
       '@','?': str:= 'unknown object';
       'H': str:= 'Hydran';
       'A': str:= 'Argelian';
       'R': str:= 'Romulan';
       'T': str:= 'Tholan';
       '*': str:= 'star';
       'M': str:= 'alien machine';
       ':': str:= 'set of crystals';
       ',': str:= 'comet';
       '^': str:= 'super bomb';
       'O': str:= 'Orion smuggler';
       '/': str:= 'Staff of Surak';
       ')',']': str:= 'set of shields';
       '.': str:= 'neutron star'
       end
     end;

     procedure impulsengine;
     label 10;
     var
    tmp: string80;
     begin
    adjspeed:= round(10*speed);
    if totalpower-shields<adjspeed then
       begin
       clrmesg;
       mesg(2,'Engineer Scott reports:');
       mesg(4,'I dinna have enough for');
       mesg(5,'  impulse power, cap''n');
       delay(3000)
       end
    else begin
       if condition= 'docked' then
          begin
          totalpower:= maxpower;
          shields:= maxpower div 2;
          condition:= 'green '
          end;
       clrmesg;
       mesg(4,'       Heading? ');
       direction := readreal;
       universe[currx,curry].ch:= ' ';
       for i:= 0 to adjspeed do
          if hit(i,x,y,currx,curry) then
        begin
         clrmesg;
         mesg(2,'   Mr. Chekov reports:');
         if (universe[x,y].ch in ['#','B']) and not baseattacked then
            begin
            if universe[x,y].ch ='B' then finishup(true);
            condition:= 'docked';
            xdock:= x;
            ydock:= y;
            moveround(x,y);
            moveship(x,y);
            mesg(4,'     shields lowered');
            mesg(5,'       ship docked');
            delay(3000);
            goto 10;
            end
         else if universe[x,y].ch = '#' then
            begin
            mesg(4,'Keptin, the starbase will');
            mesg(5,'  not allow us to dock!');
            delay(4000);
            end
         else if universe[x,y].ch = '%' then
            begin
            currx:= x;
            curry:=y;
            mesg(4,'   We have entered');
            mesg(5,'   the time portal');
            updateboard;
            clearscroll;
            gstat := -1;
            delay(5000);
            partdone := true;
            goto 10;
            end
         else begin
            findobject(x,y,tmp);
            currx:= x;
            curry:= y;
            mesg(3,'Keptin, we have collided');
            mesg(4,concat('  with a ',tmp));
            mesg(5,'All reporting decks are');
            mesg(6,'     disintegrated');
            delay(3000);
            finishup(false)
            end
         end
          else begin
         if i=adjspeed then moveship(x,y);
         if not out(computer) and not out(shortscan) then
            short(x,y)
         end
       end;
    totalpower:= totalpower - adjspeed;
     10: end;

     procedure warpdrive;
     begin
    clrmesg;
    if totalpower-shields < round(sqr(speed)/2) then
       begin
       mesg(2,'Engineer Scott reports:');
       mesg(4,' I need more power if');
       mesg(5,'you want to warp cap''n');
       delay(3000)
       end
    else begin
       mesg(4,'       Heading?');
       direction := readreal;
       if hit(round(sqr(speed)),x,y,currx,curry) then moveround(x,y);
       moveship(x,y)
       end
     end;

  begin (* move *)
     repeat
    clrmesg;
    mesg(4,'          Speed? ');
    speed := readreal;
    if (condition = 'docked') and (speed >= 1) then
       begin
       mesg(2,'         Captain');
       mesg(4,' We are docked. We must');
       mesg(5,'  use impulse to leave.');
       delay(3000)
       end
     until (speed >= 0) and ((condition <> 'docked') or
    ((condition = 'docked') and (speed < 1)));
     if speed < 1 then
    if not out(impulse) then impulsengine
    else begin
       clrmesg;
       mesg(2,'Engineering reports:');
       mesg(4,'Impulse engines are');
       mesg(5,' still out, Captain');
       delay(3000)
       end
     else if not out(warp) then
    if speed > 8 then
       begin
       clrmesg;
       mesg(3,'         Sir?');
       mesg(4,'We canna go that fast');
       delay(3000)
       end
    else warpdrive
     else begin
    clrmesg;
    mesg(2,'Engineering reports:');
    mesg(4,'      Warp drive');
    mesg(5,'     is still out');
    delay(3000)
    end
  end;

  procedure getcommand; forward;

  procedure fire(missilepower,distance,fromx, fromy:integer);
  label 10;
  var
     i,x,y:  integer;

     procedure reduce;
     var
    x2,y2:  integer;
     begin
    for y2:=-maxuni to maxuni do
       for x2:= -maxuni to maxuni do
          if universe[x2,y2].ch='+' then universe[x2,y2].strength:=
         universe[x2,y2].strength div 2;
    clearscroll;
    addscroll('Mr. Chekov reports:');
    addscroll('  Keptin, all Klingons have lost 1/2');
    addscroll('       of their power due');
    addscroll('  to our destroying their base!')
     end;

     procedure hitit;

    procedure donotdestroyed;
    begin
       case universe[x,y].ch of
          '+':  addscroll('Klingon hit but not destroyed');
          'X':  addscroll('Klingon base hit but not destroyed');
          'B','#':  begin
            addscroll('Starbase hit but not destroyed');
            baseattacked:= true
            end;
          'A':  addscroll('Argelian hit but not destroyed');
          'R':  addscroll('Romulan hit but not destroyed');
          'T':  addscroll('Tholian hit but not destroyed');
          'H':  begin
            addscroll('Hydran hit but not destroyed');
            numstr(missilepower,5,0);
            addscroll(concat('   Returning shot of ',str,' units!'));
            if allshields < 0 then
               begin
               shields:= shields - missilepower;
               totalpower:= totalpower - missilepower;
               if shields < 0 then finishup(false)
               end
            end;
          'O':  begin
            addscroll('Orion smuggler hit but not destroyed');
            addscroll('   He''s self-destructing!');
           missilepower:= rand(1000,2000);
            numstr(missilepower,5,0);
         addscroll(concat('   Prepare for blast of ',str,' units!'));
            universe[x,y].ch:= ' ';
            universe[x,y].strength:= 0;
            if allshields < 0 then
               begin
               shields:= shields - missilepower;
               totalpower:= totalpower -missilepower;
               if shields < 0 then finishup(false)
               end
            end;
          '/','M','%',',',':',')',']','.','*':
            addscroll('Shot blocked')
          end;
       scroll;
       if not (universe[x,y].ch in ['H','O']) then
          universe[x,y].strength:= universe[x,y].strength - missilepower
    end;

     begin
       if universe[x,y].ch = '?' then
     begin
       doquestion(x,y,fired);
       partdone := true;
     end
       else
    begin
       if universe[x,y].ch in ['B','#'] then
          addscroll('Captain, we''ve just hit a starbase');
       if missilepower > universe[x,y].strength then
          begin
          case universe[x,y].ch of
         ',','R','T','H','+','A':  begin
               case universe[x,y].ch of
             'A':  addln('***Argelian shape-changer');
             'R':  addln('***Romulan');
             'T':  addln('***Tholian');
             'H':  addln('***Hydran');
             '+':  begin
                   addln('***Klingon');
                   nmbrkling:= nmbrkling - 1
                   end;
             ',':  addln('***Comet')
             end;
               addscroll(' destroyed***');
               numstr(ord(universe[x,y].pts),2,0);
               addscroll(concat(str,' points'));
               points:= points + ord(universe[x,y].pts);
               end;
         'X':  begin
               addscroll('***Klingon base destroyed***');
              reduce
               end;
         '#':  begin
               addscroll('***Starbase destroyed***');
               nmbrbases:= nmbrbases - 1;
               baseattacked:= true
               end
         end;
          universe[x,y].ch:= ' ';
          universe[x,y].strength:= 0;
          printch(50+x-currx,5-y+curry,' ');
          end
       else donotdestroyed
     end;
     end;

  begin  (* fire *)
    for i:= 1 to distance do
      if hit(i,x,y,fromx,fromy) then
       begin
      if universe[x,y].ch <> '*' then
        begin
          numstr(missilepower,4,0);
          while pos(str,'0') <> 0 do str[pos(str,'0')]:= ' ';
         addscroll(concat(str,' unit hit'))
        end;
      hitit;
      goto 10;
    end
      else if i=distance then addscroll('Out of range');
  10:end;

  procedure torpedo;
  label 10;
  const
     maxtorps = 4;
  var
     number, i:  integer;
     direct:  array[1..maxtorps] of real;
     prompt: string80;
  begin
     partdone := false;
     if nmbrtorps > 0 then
    if condition<> 'docked' then
      if not out(torpedos) then
          begin
          repeat
         clrmesg;
         mesg(4,'   How many torpedos?');
         number := readint;
         if (number > nmbrtorps) or (number > maxtorps) then
            begin
            mesg(3,'        Captain');
            mesg(4,' we can''t fire that many');
            mesg(5,'        torpedos');
            delay(3000)
            end
          until (number <= nmbrtorps) and (number <= maxtorps);
          prompt:= 'Direction of torpedo #i?';
          for i:= 1 to number do
         begin
         prompt[23]:= chr(48 + i);
         clrmesg;
         mesg(4,prompt);
         direct[i] := readreal;
         end;
          for i:= 1 to number do
         begin
         direction:= direct[i];
         if longer > -1 then fire(1000,10,currx,curry)
         else fire(1000,6,currx,curry);
         if partdone then
            goto 10;
         nmbrtorps:= nmbrtorps - 1;
         scroll
         end
          end
      else begin
          clrmesg;
          mesg(4,'Torpedos not functional')
          end
    else begin
       clrmesg;
       mesg(3,'        Captain');
       mesg(4,' we are not allowed to');
       mesg(5,'   shoot while docked');
       end
    else begin
       clrmesg;
       mesg(4,'    Still out of torpedos');
       end;
10:end;


procedure phaser;
const
     maxshots = 4;
var
     requested, number,i: integer;
     direct:  array[1..maxshots] of real;
     strength:  array [1..maxshots] of integer;
     prompt1,prompt2: string80;
 begin
     if not out(phasers) then
    if condition <> 'docked' then
       begin
       repeat
          repeat
         clrmesg;
         mesg(4,'        How many?');
         number := readint;
         if number > maxshots then
            begin
            mesg(3,'        Captain');
            mesg(4,' we can''t fire that many');
            delay(3000)
            end
          until (ioresult = 0) and (number <= maxshots) ;
          requested:= 0;
         prompt1:= 'Strength of phaser #i?';
          for i:=1 to number do
         begin
         prompt1[21]:= chr(48 + i);
         clrmesg;
         mesg(4,prompt1);
         strength[i] := readint;
         requested:= requested + strength[i]
         end;
          if requested > totalpower - shields then
         begin
         mesg(2,'Engineer Scott reports:');
         mesg(4,'Cap''n, we only got sae');
         mesg(5,'  much power. I canna ');
         mesg(6,'   gie ye that much.');
         delay(3000)
         end
       until requested <= totalpower - shields;
       prompt2:= 'Direction of phaser #i?';
       for i:= 1 to number do
          begin
          clrmesg;
          prompt2[22]:= chr(48+i);
          mesg(4,prompt2);
          direct[i] := readreal;
          end;
       for i:= 1 to number do
          begin
          direction:= direct[i];
         fire(strength[i],10,currx,curry);
          totalpower:= totalpower-strength[i];
          end
      end
    else begin
       clrmesg;
       mesg(3,'        Captain');
       mesg(4,'  we''re not allowed to');
       mesg(5,'    shoot while docked.')
       end
     else begin
    clrmesg;
    mesg(2,' Weapons Room reports:');
    mesg(4,' Phasers are still out');
    mesg(5,'          sir')
    end
  end;

  procedure systemchek;
  var
     i: system;
     line,up:  integer;
  begin
     if condition = 'docked' then
    begin
    totalpower:= maxpower;
    shields:= universe[xdock,ydock].strength;
    nmbrtorps:= 8
    end;
     for i:= computer to impulse do begin
    if condition = 'docked' then up:= 10
    else up:= rand(0,5);
    if systems[i]+ up <100 then systems[i]:= systems[i]+up
    else systems[i]:= 100;
    if not out(computer) then begin
       line := ord(i) + 13;
       gotoxy(47,line+1);
       if systems[i] < opefficiency then
           begin textcolor(Red + Blink); textbackground(8); end
       else
           begin textcolor(WHITE); textbackground(Black); end;
       writenum(systems[i],3,47,line);
       write('%');
       if systems[i] < opefficiency then
           begin textcolor(WHITE); textbackground(Black); end
     end
       end;
     totalpower:= totalpower+ rand(0,10)
  end;

  procedure save;
  var
     fname:string80;
  begin
     gstat := 7;
     clearscroll;
     addln('File to save as?');
     readln(con,fname);
     assign(g,fname);
     rewrite(g);
     blockwrite(g,msginfo[1],37*4);
     close(g);
     alldone := true;
  end;

  procedure quit;
  label 10;
  var
     s : string[1];
     answer: char;
  begin
     clearscroll;
     togglecursor;
     addscroll('Confirm:  you wish to quit?');
     addscroll('Y:quits, R:restores, S:saves');
     read(kbd,answer);
     s := ' ';
     s[1] := answer;
     addscroll(s);
     if answer in ['S','s'] then save
     else if answer in['R','r'] then
       begin
     gstat:= -3;
     alldone := true;
     partdone := true;
     togglecursor;
     goto 10;
       end
     else if answer in ['Y', 'y'] then
       begin
     gstat:= 1;
     finishup(true)
       end  ;
  10: end;


  procedure getcommand;
  label 10;
  var
     command: char;
     ch: char;
     accumulate, i, limit: integer;
     prompt: packed array[0..8] of char;

  begin
    if alldone then goto 10;
    prompt:= 'COMMAND ?';
    if not out(longscan) then
    if confuse < 0 then
        scanlong; (* JOHN PLOCHER *)
    repeat
      accumulate:= 0;
      if level > 7 then limit:= rand(20,points div 300)
      else limit:= 25;
      while not keypressed and (accumulate <= limit) do
    begin
    if not keypressed then delay(200 * skill);
    gotoxy(55,15); write(prompt);
    if not keypressed then delay(200 * skill);
    accumulate:= accumulate + 1;
    gotoxy(55,15); write('         ');
    end;
      gotoxy(55,15);
      if not keypressed then begin
      write('        ');
      command:= ' '
      end
      else begin
      read(kbd,command);
      write(command);
      end;
      partdone := false;
      if command = chr(13) then clearscroll
      else if confuse < 0 then
    case command of
       ' '    : clearscroll;
       'W','w',
       'G','g',
       'D','d',
       'U','u':  begin
               gstat:= ord(command);
               partdone := true;
             end;
       'I','i':  battleinfo;
       'T','t':  torpedo;
       'P','p':  phaser;
       'S','s':  raiseshields;
       'M','m':  move;
       'Q','q':  quit
    end
      else
    begin
      clrmesg;
      mesg(3,'         What?');
    end;
    until partdone or
      (command in ['Q','q',' ','M','m','T','t','P','p','S','s']);
  10:end {getcommand};

  procedure doquestion {questx,questy : integer; encounter : attack};
  var
     idx,jdx,j, result: integer;
     i: system;
     cmd : packed array[0..3] of char;
  begin
     if encounter = fired then result:= rand(1,7)
     else result:= rand(1,10);
     universe[questx,questy].ch:= ' ';
     printch(50+questx-currx,5+curry-questy,' ');
     clearscroll;
     for jdx := 1 to 100 do begin
     sound(rand(100,5000));
     delay(rand(50,200));
     nosound;
     end;
     case result of
    1:  begin
        currx:= currx + rand(-200, 200);
        curry:= curry + rand(-200, 200);
        writestuff(1)
        end;
    2:  begin
        stardate:= stardate + rand(0,100) div 10;
        writestuff(2)
        end;
    3:  begin
        totalpower:= rand(0,500);
        shields:= totalpower div 2;
        writestuff(3)
        end;
      4,7:  if syshields < 0 then
          begin
          systems[phasers]:= 0;
          systems[torpedos]:= 0;
          nmbrtorps:= 0;
          totalpower:= shields;
          writestuff(4)
         end;
    5:  if syshields < 0 then
           begin
           for i:= computer to impulse do systems[i]:= rand(0,systems[i]);
           writestuff(5)
           end;
    6:  begin
        enemyattack(pass);
        writestuff(6)
        end;
    8:  begin
        totalpower:= totalpower + 10000;
        writestuff(8)
        end;
    9:  begin
        stardate:= stardate - rand(0,100) div 10;
        writestuff(9)
        end;
       10:  begin
        for i:= computer to impulse do systems[i]:= 100;
        writestuff(10)
        end
    end;
  end; {do question}

begin
  { gstat   | meaning                   }
  { --------+-------------------------- }
  {  -2     |                           }
  {  -1     |                           }
  {   0     | destroyed (shields < 0)   }
  {   1     | quit                      }
  {   2     | ran out of time           }
  {   3     | successful return         }
  {   4     | collided with something   }
  {   5     | didn't fulfill mission    }
  {   6     | player gets 1st move      }
  {   7     | saved game                }

  repeat
    if gstat = 6 then gstat := 3 { called with 3 when enemy gets first move }
    else                         { called with 6 when player gets first move}
      begin  { note:  only at inception of playgame from then on gstat = 3 }
    allshields := allshields - 1;
    syshields  := syshields - 1;
    confuse    := confuse - 1;
    nomove     := nomove - 1;
    seeall     := seeall - 1;
    longer     := longer - 1;
    stardate   := stardate + 0.1;
    if stardate > deadline then finishup(false);
    enemyattack(go); (* fire at ship,etc.*)
    systemchek
      end;
    clrmesg;
    if not out(computer) then updateboard
    else
      begin
    if rand(0,9) = 3 then updateboard;
    mesg(4, '  Computer unreliable')
      end;
    getcommand { and do it }
  until partdone or alldone;
10: end; { playgame}